Celestin Apprentice 5/Apprentice-Release5.iso/Source Code/C/Applications/GW AdaEd 1.4.2/GWAdaDemos/Spider/SPIDER.ADB

Text File | 1994-01-10 | 7.4 KB | 298 lines | [TEXT/GADA]

WITH Text_IO;
PACKAGE My_Int_IO IS NEW Text_IO.Integer_IO(Num => Integer);

WITH Text_IO;
WITH Calendar;   -- standard Ada Package
USE  Calendar;
WITH My_Int_IO;

PACKAGE BODY Spider IS
-- IMPLEMENTATION of Spider Graphics Package
-- with no ANSI colors
-- by John Dalbey December 1992
-- contributed to the public domain.
--
Screen_Depth : CONSTANT Integer := 24;
Screen_Width : CONSTANT Integer := 80;

TYPE Direction        IS (north,east,south,west);
TYPE DirectionSymbols IS ARRAY (Direction) OF character;
TYPE Palette          IS ARRAY (ScreenColors) OF character;

SUBTYPE Depth IS Integer RANGE 1..Screen_Depth;
SUBTYPE Width IS Integer RANGE 1..Screen_Width;

Column       : width;                 -- spider's position
Row          : depth;                      --      in the room.
Heading      : Direction ;                  -- spider's direction
Ink          : ScreenColors;                -- color being drawn
DebugFlag    : boolean          := false;   -- Is single stepping on?
RoomSize     : depth;                -- generated randomly
RowHi        : depth := 22;          -- room upper boundary for row
ColHi        : width := 40;          -- room upper boundary for column

Spidersym    : constant character := '*';   -- asterisk
LoBound      : constant integer := 1;       -- room lower boundary
WindowOffset : constant integer := 20;
ColorSymbols : constant Palette := ('+','X','O','.'); -- ASCII symbols for color
Compass      : constant DirectionSymbols := ('^','>','V','<');

  PROCEDURE MoveCursor (Row : Depth;Column : Width) IS
  -- Move the cursor to a particular row and column on the screen.
  BEGIN
    Text_IO.Put (Item => ASCII.ESC);
    Text_IO.Put ("[");
    My_Int_IO.Put (Item => Row, Width => 1);
    Text_IO.Put (Item => ';');
    My_Int_IO.Put (Item => Column, Width => 1);
    Text_IO.Put (Item => 'f');
  END MoveCursor;

PROCEDURE DrawStatus IS
BEGIN
    -- Draw Status Box in upper left corner showing current direction.
    MoveCursor (1,1);
    Text_IO.Put (" --- ");
    MoveCursor (2,1);
    Text_IO.Put ("|   |");
    MoveCursor (3,1);
    Text_IO.Put ("|   |");
    MoveCursor (4,1);
    Text_IO.Put (" --- ");
END DrawStatus;

PROCEDURE DrawRoom  IS
--  Draw the Spider's room (fixed size).
  i: integer;
  BEGIN
    Text_IO.PUT (ASCII.ESC);
    Text_IO.Put (Item => "[2J"); -- clear screen
    MoveCursor (1,1);
    -- Top Bar
    Text_IO.Put ("                    ");
    Text_IO.Put ("----------------------------------------- ");
    Text_IO.New_Line;
    FOR I in 1..21 LOOP
    Text_IO.Put ("                   |");
    Text_IO.Put (". . . . . . . . . . . . . . . . . . . . .|");
    Text_IO.New_Line;
    END LOOP;
    Text_IO.Put ("                    ");
    Text_IO.Put ("----------------------------------------- ");
    DrawStatus;
  END DrawRoom;


  PROCEDURE DrawRoom (Size: depth) IS
  --  Draw the Spider's room (variable size).
  i: integer;
  BEGIN
    Text_IO.PUT (ASCII.ESC);
    Text_IO.Put (Item => "[2J"); -- clear screen
    MoveCursor (1,1);
    -- Top Bar
    Text_IO.Put ("                    ");
    FOR i in 1..Size-1 LOOP
       Text_IO.Put ("--");
    END LOOP;
    Text_IO.Put ("-");
    Text_IO.New_Line;
    -- Side Bars
    FOR I in 1..Size LOOP
       Text_IO.Put ("                   |");
       FOR i in 1..Size-1 LOOP
          Text_IO.Put (". ");
       END LOOP;
       Text_IO.Put (".|");
       Text_IO.New_Line;
    END LOOP;
    -- Bottom Bar
    Text_IO.Put ("                    ");
    FOR i in 1..Size-1 LOOP
       Text_IO.Put ("--");
    END LOOP;
    Text_IO.Put ("-");
    DrawStatus;
  END DrawRoom;

PROCEDURE ChgColor (NewColor : ScreenColors) IS
-- Change the color the spider is using.
BEGIN
    Ink := NewColor;
    MoveCursor (3,3);
    Text_IO.Put (ColorSymbols(Ink));
END ChgColor;

PROCEDURE ShowDirection IS
-- Show the current direction
BEGIN
    MoveCursor(2,3);
    Text_IO.Put (Compass(heading));
END ShowDirection;

PROCEDURE ShowSpider IS
-- Show the spider symbol
BEGIN
    MoveCursor (Row+1, Column+WindowOffset);
    Text_IO.Put (SpiderSym);
    MoveCursor (2,3);  -- HIdecursor
END ShowSpider;

PROCEDURE Reset IS
-- Create a fixed size room and reset the spider.
BEGIN
    DrawRoom;
    Column := 21;
    Row := 11;
    Heading := south;
    Green;
    ShowSpider;
    ShowDirection;
END Reset;

  FUNCTION Random RETURN Integer IS
  -- RAndom number generator based on clock time.
  Now: Time;
  Yr: Year_Number;
  Mo: Month_Number;
  Dy: Day_Number;
  Seconds: Day_Duration;       -- seconds past midnight
  BEGIN
     Now := Clock;
     Split (Now, Yr, Mo, Dy, Seconds);
     Return ( ABS INTEGER(Seconds) mod 1000) ;
  END Random;

PROCEDURE Start IS
-- Create a random sized room and reset the spider.
BEGIN
    RoomSize :=  (Random MOD (RowHi-1)) + 2;
    DrawRoom(RoomSize);
    Row := 1;
    Column := 1;
    RowHi := RoomSize;
    ColHi := RoomSize*2-1;
    Heading := east;
    Green;
    ShowSpider;
    ShowDirection;
END Start;

-- Color commands
PROCEDURE Blue IS
BEGIN
    ChgColor (blue);
END Blue;
PROCEDURE Green IS
BEGIN
    ChgColor (green);
END Green;
PROCEDURE Red IS
BEGIN
    ChgColor (red);
END Red;
PROCEDURE Black IS
BEGIN
    ChgColor (black);
END Black;


PROCEDURE Step IS
-- Take a step forward command.
OB      : boolean := false;  -- out of bounds flag
AnyThing: character;

Hit_The_Wall: exception;

BEGIN
    -- put a block down where spider is standing
    MoveCursor(Row+1,Column+WindowOffset);
    Text_IO.Put (ColorSymbols (Ink) );

    -- Check for out of bounds
    CASE heading IS
      WHEN north => IF Row <= LoBound THEN OB := true; END IF;
      WHEN east  => IF Column >= ColHi THEN OB := true; END IF;
      WHEN south => IF Row >= RowHi THEN OB := true; END IF;
      WHEN west  => IF Column <= LoBound THEN OB := true; END IF;
    END CASE;

    -- If out of bounds raise and exception.
    IF OB THEN
      Text_IO.New_Line;
      Quit;
      raise Hit_The_Wall;
    END IF;

    -- change the location coordinates
    CASE heading IS
      WHEN north => Row := Row - 1;
      WHEN east  => Column := Column + 2;
      WHEN south => Row := Row + 1;
      WHEN west  => Column := Column - 2;
    END CASE;

    -- draw the spider in her new location
    ShowSpider;
    IF Debug THEN   -- if debug mode, wait for user to press return
         WHILE NOT Text_IO.End_of_line LOOP
            Text_IO.Get ( Anything );
         END LOOP;
         Text_IO.Skip_Line;
    END IF;
END Step;

PROCEDURE Turn IS
-- Turn to the right command.
BEGIN
    IF Heading = Direction'Last THEN
       Heading := Direction'First;
    ELSE    Heading := Direction'succ (Heading);
    END IF;
    ShowDirection;
END Turn;

FUNCTION AtWall return BOOLEAN IS
-- RETURN True if spider is adjacent to and facing a wall.
BEGIN
    -- Check for out of bounds
    CASE heading IS
      WHEN north => return  Row <= LoBound;
      WHEN east  => return  Column >= ColHi;
      WHEN south => return  Row >= RowHi;
      WHEN west  => return  Column <= LoBound;
    END CASE;
END AtWall;

PROCEDURE Quit IS
-- Quit command.
BEGIN
    MoveCursor(24,1);
END Quit;

PROCEDURE Debug (Setting: Switch) is
-- Toggle debugging mode
BEGIN
   IF Setting = ON THEN
       DebugFlag := true;
       MoveCursor (10,1);
       Text_io.Put ("-- DEBUG ON -- ");
       Text_io.New_Line;
       Text_IO.Put ("  Press Enter");
   ELSE
       DebugFlag := false;
       MoveCursor (10,1);
       Text_io.Put ("               ");
       Text_io.New_Line;
       Text_IO.Put ("             ");
   END IF;
END Debug;

FUNCTION Debug return boolean is
BEGIN
   Return DebugFlag;
END Debug;

END Spider;